home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AOL File Library: 11,000 to 11,999
/
11000.zip
/
AOLDLs
/
Programmieren [Delphi - Units]
/
WAVEIN_ TWaveInOut
/
WAVEIN~1.pas
< prev
Wrap
Pascal/Delphi Source File
|
2014-12-20
|
8KB
|
290 lines
unit WaveInOut;
{ Copyright RL Software 1997. Homepage: http://members.aol.com/DReiche202/Welcome.htm/}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
mmsystem;
const
WAVE_FORMAT_ADPCM = $0002; // Microsoft Corporation */
WAVE_FORMAT_ALAW = $0006; // Microsoft Corporation */
type TWaveInOutInputProc = procedure( buffer: pChar; size: Integer ) of object;
type TWaveInOutPlayedProc = procedure of object;
type
TWaveInOut = class(TComponent)
private
{ Private-Deklarationen }
WAVEIN: HWAVEIN;
WAVEOUT: HWAVEOUT;
WaveBuffer: pChar;
WBuffer1: pChar;
WBuffer2: pChar;
AktBuffer: Integer;
WAVEINHDR: TWAVEHDR;
WAVEOUTHDR: TWAVEHDR;
isInOpen: Boolean;
isOutOpen: Boolean;
FInputProc: TWaveInOutInputProc;
FPlayedProc: TWaveInOutPlayedProc;
FBufferSize: Integer;
FUnlInput: Boolean;
wincontrol: TWinControl;
procedure SetBuffer( size: Integer );
protected
{ Protected-Deklarationen }
FABHandle: THandle;
OldWndProc: TFarProc;
NewWndProc: Pointer;
procedure HookWin;
procedure UnHookWin;
procedure HookWndProc(var Message: TMessage);
public
{ Public-Deklarationen }
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
procedure OpenInput; // initialisiert und startet Aufzeichnung
procedure CloseInput; // beendet Aufzeichnung
procedure RequestInput; // startet erneute Aufzeichnung
procedure OpenOutput; // initialisiert Player
procedure CloseOutput; // beendet playing
procedure PlaySound( buffer: pChar; len: Integer ); // gibt Speicherbereich akustisch aus
published
{ Published-Deklarationen }
property OnInput: TWaveInOutInputProc read FInputProc write FInputProc;
property OnPlayed: TWaveInOutPlayedProc read FPlayedProc write FPlayedProc;
property BufferSize: Integer read FBufferSize write SetBuffer default 4096;
property AutoRequest: Boolean read FUnlInput write FUnlInput default False;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Extern', [TWaveInOut]);
end;
constructor TWaveInOut.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
isInOpen := False;
isOutOpen := False;
wincontrol := TWinControl.Create( Self );
wincontrol.Parent := Screen.Forms[0];
FABHandle := wincontrol.Handle;
HookWin();
end;
destructor TWaveInOut.Destroy;
begin
CloseInput();
CloseOutput();
UnHookWin();
if ( WaveBuffer <> Nil ) and ( FBufferSize > 0 ) then
FreeMem( WaveBuffer );
inherited Destroy;
end;
procedure TWaveInOut.SetBuffer( size: Integer );
begin
if WBuffer1 <> Nil then
begin
FreeMem( WBuffer1 );
WBuffer1 := Nil;
end;
if WBuffer2 <> Nil then
begin
FreeMem( WBuffer2 );
WBuffer2 := Nil;
end;
FBufferSize := size;
GetMem( WBuffer1, FBufferSize );
GetMem( WBuffer2, FBufferSize );
if AktBuffer = 0 then
WaveBuffer := WBuffer1
else
WaveBuffer := WBuffer2;
end;
procedure TWaveInOut.OpenInput;
var
wf: TWaveFormatEx;
res: MMRESULT;
begin
with wf do
begin
wFormatTag := WAVE_FORMAT_ALAW;
nChannels := 1;
nSamplesPerSec := 11025;
nAvgBytesPerSec := 11025;
nBlockAlign := 1;
wBitsPerSample := 8;
cbSize := SizeOf( TWaveFormatEx );
end;
with WAVEINHDR do
begin
lpData := WaveBuffer; { pointer to locked data buffer }
dwBufferLength := FBufferSize; { length of data buffer }
dwBytesRecorded := 0; { used for input only }
dwFlags := 0; { assorted flags (see defines) }
dwLoops := 0; { loop control counter }
end;
case waveInOpen( @WAVEIN, 0, @wf, FABHandle, 0, CALLBACK_WINDOW ) of
MMSYSERR_NOERROR: isInOpen := True;
end;
if isInOpen then
begin
waveInPrepareHeader( WAVEIN, @WAVEINHDR, sizeof( TWAVEHDR ) );
waveInAddBuffer( WAVEIN, @WAVEINHDR, sizeof( TWAVEHDR ) );
waveInStart( WAVEIN );
end;
end;
procedure TWaveInOut.CloseInput;
begin
if isInOpen then
begin
waveInStop( WAVEIN );
(*
if assigned( FInputProc ) and ( WAVEINHDR.dwBytesRecorded > 0 ) then
FInputProc( WaveBuffer, WAVEINHDR.dwBytesRecorded );
*)
waveInClose( WAVEIN );
isInOpen := False;
end;
end;
procedure TWaveInOut.RequestInput;
begin
if isInOpen then
begin
if AktBuffer = 0 then
WAVEINHDR.lpData := WBuffer2
else
WAVEINHDR.lpData := WBuffer1;
waveInPrepareHeader( WAVEIN, @WAVEINHDR, sizeof( TWAVEHDR ) );
waveInAddBuffer( WAVEIN, @WAVEINHDR, sizeof( TWAVEHDR ) );
waveInStart( WAVEIN );
end;
end;
procedure TWaveInOut.OpenOutput;
var
wf: TWaveFormatEx;
res: MMRESULT;
begin
with wf do
begin
wFormatTag := WAVE_FORMAT_ALAW;
nChannels := 1;
nSamplesPerSec := 11025;
nAvgBytesPerSec := 11025;
nBlockAlign := 1;
wBitsPerSample := 8;
cbSize := SizeOf( TWaveFormatEx );
end;
case waveOutOpen( @WAVEOUT, WAVE_MAPPER, @wf, FABHandle, 0, CALLBACK_WINDOW ) of
MMSYSERR_NOERROR: isOutOpen := True;
end;
end;
procedure TWaveInOut.CloseOutput;
begin
if isOutOpen then
begin
waveOutClose( WAVEOUT );
isOutOpen := False;
end;
end;
procedure TWaveInOut.PlaySound( buffer: pChar; len: Integer );
begin
if isOutOpen then
begin
with WAVEOUTHDR do
begin
lpData := buffer; { pointer to locked data buffer }
dwBufferLength := len; { length of data buffer }
dwBytesRecorded := 0; { used for input only }
dwFlags := 0; { assorted flags (see defines) }
dwLoops := 0; { loop control counter }
end;
waveOutPrepareHeader( WAVEOUT, @WAVEOUTHDR, sizeof( TWAVEHDR ) );
waveOutWrite( WAVEOUT, @WAVEOUTHDR, sizeof( TWAVEHDR ) );
end;
end;
procedure TWaveInOut.HookWin;
begin
OldWndProc := TFarProc(GetWindowLong(FABHandle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(FABHandle, GWL_WNDPROC, LongInt(NewWndProc));
end;
procedure TWaveInOut.UnhookWin;
begin
SetWindowLong( FABHandle, GWL_WNDPROC, LongInt(OldWndProc) );
if assigned( NewWndProc ) then
FreeObjectInstance( NewWndProc );
NewWndProc := nil;
end;
procedure TWaveInOut.HookWndProc(var Message: TMessage);
var
recorded: Integer;
begin
with Message do
begin
case Msg of
MM_WIM_DATA:
begin
recorded := WAVEINHDR.dwBytesRecorded;
if FUnlInput then
RequestInput();
if assigned( FInputProc ) then
FInputProc( WaveBuffer, recorded );
if FUnlInput then
begin
if AktBuffer = 0 then
begin
WaveBuffer := WBuffer2;
AktBuffer := 1;
end
else
begin
WaveBuffer := WBuffer1;
AktBuffer := 0;
end;
end;
end;
MM_WOM_DONE:
begin
if assigned( FPlayedProc ) then
FPlayedProc();
end;
end; // case .. of
result := CallWindowProc( OldWndProc, FABHandle, Msg, wParam, lParam );
end;
end;
end.